home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / AMOSPRO4.DMS / in.adf / Tutorials / Menus / Menus_9.AMOS / Menus_9.amosSourceCode
Encoding:
AMOS Source Code  |  1992-09-28  |  5.9 KB  |  251 lines
  1. '*************************** 
  2. '*    AMOS Professional    * 
  3. '*                         * 
  4. '*         MENUS 9         * 
  5. '*                         *                  FULL EXAMPLE 
  6. '* (c) Europress Software  * 
  7. '*                         * 
  8. '*     Ronnie Simpson      * 
  9. '*************************** 
  10. '
  11. '------------------------------------------- 
  12. '
  13. ' The following program is an example of how a menu may be used as the 
  14. ' only user input for a full program. It uses a menu loaded from a bank
  15. ' which was defined in the previous tutorial MENUS_8.
  16. '
  17. ' Use arrow keys to scroll info bar. 
  18. ' Use background mode to select background colours of pattern fill 
  19. '
  20. '------------------------------------------- 
  21. Global M,P,F,B,O,T,S,W,H
  22. '
  23. Rem *** Open and position the 3 screens required and load bobs 
  24. '
  25. Screen Open 3,320,40,32,Lowres : Flash Off : Curs Off : Cls 0
  26. Screen Display 3,,220,, : H=220
  27. Screen Open 1,320,200,32,Lowres
  28. Screen Open 0,320,200,32,Lowres
  29. Load "AMOSPro_Tutorial:Objects/Menu_Bobs.Abk"
  30. Palette 0,$BDF,$FF,$FF0,$F0F,$F0,$F,$F00,$F70,$7F,$500,$50,$5,$900,$90,$9,$950,$59,$222,$333,$444,$555,$666,$777,$888,$999,$AAA,$BBB,$CCC,$DDD,$EEE,$FFF
  31. F=4 : B=0 : O=6 : M=1 : P=1 : T=True
  32. Flash Off : Curs Off : Cls 0 : Pen 4 : Paper 0 : Ink F,B,O : NC=32
  33. '
  34. Rem *** Load menu data to bank 
  35. '
  36. Load "AMOSPro_Tutorial:Tutorials/Menus/Data.Menu",6
  37. '
  38. Bank To Menu 6
  39. Erase 6
  40. '
  41. Menu On 
  42. On Menu Proc PI,MO,CO,DR,PA
  43. On Menu On 
  44. '
  45. Change Mouse 2
  46. '
  47. MARKUP
  48. '
  49. Do 
  50.    If Key State(77) and H<300 Then Inc H : Screen Display 3,,H,,
  51.    If Key State(76) and H>20 Then Dec H : Screen Display 3,,H,,
  52.    If Mouse Key=1 Then Screen To Front 0 : Proc ACT[X Screen(X Mouse),Y Screen(Y Mouse)]
  53. Loop 
  54. '
  55. Procedure PI
  56.    On Choice(2) Gosub P1,P2,P3,P4,P5
  57.    On Menu On : MARKUP : Pop Proc
  58.    P1:
  59.    F$=Fsel$("AmosPro_Examples:IFF/*.Iff","","LOAD AN IFF PICTURE")
  60.    If F$>""
  61.       Load Iff F$,1 : Load Iff F$,0
  62.       Limit Mouse 128,42 To 127+Screen Width,41+Screen Height
  63.    End If 
  64.    NC=Screen Colour
  65.    If NC=4096 Then NC=16
  66.    If NC=64 Then NC=32
  67.    For N=1 To NC : Menu Active(3,N) : Next 
  68.    If NC<32
  69.       For N=NC+1 To 32 : Menu Inactive(3,N) : Next 
  70.    End If 
  71.    Return 
  72.    P2: F$=Fsel$("*.Iff","","SAVE AN IFF PICTURE")
  73.    If F$>""
  74.       Save Iff F$
  75.    End If 
  76.    Return 
  77.    P3:
  78.    Cls B
  79.    Return 
  80.    P4:
  81.    Screen Copy 1 To 0
  82.    Return 
  83.    P5: Edit 
  84. End Proc
  85. '
  86. Procedure MO
  87.    On Choice(2) Gosub M1,M2,M3,M4,M5
  88.    On Menu On : MARKUP : Pop Proc
  89.    M1:
  90.    T=True
  91.    Return 
  92.    M2:
  93.    T=False
  94.    Return 
  95.    M3:
  96.    Set Paint 1 : S=True
  97.    Return 
  98.    M4:
  99.    Set Paint 0 : S=False
  100.    Return 
  101.    M5:
  102.    O=Choice(3)-1
  103.    Ink ,,O
  104.    Return 
  105. End Proc
  106. '
  107. Procedure CO
  108.    C=Choice(2) : Dec C
  109.    If T Then Ink C : Pen C : F=C : Else Ink ,C : Paper C : B=C
  110.    On Menu On : MARKUP
  111. End Proc
  112. '
  113. Procedure DR
  114.    M=Choice(2)
  115.    Change Mouse 2
  116.    If M=3 Then Change Mouse 21
  117.    If M=8 Then Change Mouse 22
  118.    On Menu On : MARKUP
  119. End Proc
  120. '
  121. Procedure PA
  122.    On Choice(2) Gosub 1,2,3
  123.    On Menu On : MARKUP : Pop Proc
  124.    1
  125.    Set Pattern P : W=True
  126.    Return 
  127.    2
  128.    Set Pattern 0 : W=False : P=0
  129.    Return 
  130.    3
  131.    P=Choice(3)
  132.    Return 
  133. End Proc
  134. '
  135. Procedure ACT[X,Y]
  136.    Screen Copy 0 To 1 : Ink F,B,O
  137.    On M Gosub A1,A2,A3,A4,A5,A6,A7,A8
  138.    MARKUP : Pop Proc
  139.    A1:
  140.    While Mouse Key=1
  141.       Plot X Screen(X Mouse),Y Screen(Y Mouse)
  142.       Plot X Screen(X Mouse)+1,Y Screen(Y Mouse)
  143.    Wend 
  144.    Return 
  145.    A2:
  146.    Gr Writing 2
  147.    While Mouse Key=1
  148.       X2=X Screen(X Mouse) : Y2=Y Screen(Y Mouse)
  149.       Draw X,Y To X2,Y2 : Draw X,Y To X2,Y2
  150.    Wend 
  151.    Gr Writing 1 : Draw X,Y To X2,Y2
  152.    Return 
  153.    A3:
  154.    Hide : Wait 5
  155.    Sprite 2,X Hard(X),Y Hard(Y),18
  156.    Clear Key : Gr Writing 0
  157.    Repeat 
  158.       T$=Inkey$
  159.       Exit If T$=Chr$(13)
  160.       If T$>""
  161.          Add X,8 : Sprite 2,X Hard(X),,
  162.          If X>632
  163.             X=0 : Add Y,8
  164.          End If 
  165.          Text X-8,Y+6,T$
  166.       End If 
  167.    Until Mouse Key
  168.    Sprite 2,,500, : Gr Writing 1 : Show 
  169.    Return 
  170.    A4:
  171.    Gr Writing 2
  172.    While Mouse Key=1
  173.       R1=Abs(X-X Screen(X Mouse)) : If Screen Width=640 Then R1=R1/2
  174.       R2=Abs(Y-Y Screen(Y Mouse)) : R=Max(R1,R2) : If R=0 Then R=1
  175.       Circle X,Y,R : Circle X,Y,R
  176.    Wend 
  177.    Gr Writing 1
  178.    Circle X,Y,R
  179.    Return 
  180.    A5:
  181.    Gr Writing 2
  182.    While Mouse Key=1
  183.       R1=Abs(X-X Screen(X Mouse)) : R2=Abs(Y-Y Screen(Y Mouse))
  184.       If R1=0 Then R1=1
  185.       If R2=0 Then R2=1
  186.       Ellipse X,Y,R1,R2 : Ellipse X,Y,R1,R2
  187.    Wend 
  188.    Gr Writing 1
  189.    Ellipse X,Y,R1,R2
  190.    Return 
  191.    A6:
  192.    Gr Writing 2
  193.    While Mouse Key=1
  194.       X2=X Screen(X Mouse) : Y2=Y Screen(Y Mouse)
  195.       Box X,Y To X2,Y2 : Box X,Y To X2,Y2
  196.    Wend 
  197.    Gr Writing 1
  198.    Box X,Y To X2,Y2
  199.    Return 
  200.    A7:
  201.    Gr Writing 2
  202.    While Mouse Key=1
  203.       X2=X Screen(X Mouse) : Y2=Y Screen(Y Mouse)
  204.       Box X,Y To X2,Y2 : Box X,Y To X2,Y2
  205.    Wend 
  206.    Gr Writing 1 : Set Pattern P
  207.    If X=X2 Then Goto MISS
  208.    If Y=Y2 Then Goto MISS
  209.    Bar X,Y To X2,Y2
  210.    MISS:
  211.    Return 
  212.    A8:
  213.    While Mouse Key=1
  214.    Wend : Set Pattern P
  215.    Paint X,Y
  216.    Return 
  217. End Proc
  218. Procedure MARKUP
  219.    Screen 3 : Screen To Front 3 : Get Palette 0 : Colour 31,$4 : Cls 31
  220.    Ink 2 : Draw 0,0 To 319,0 : Draw 0,39 To 320,39
  221.    Pen 2 : Paper 31
  222.    Locate 0,1 : Print "Foreground colour"
  223.    Locate 0,2 : Print "Background colour"
  224.    Locate 0,3 : Print "   Outline colour"
  225.    Set Pattern 0
  226.    Ink 2 : Box 140,24 To 148,32 : Box 140,16 To 148,24 : Box 140,8 To 148,16
  227.    Ink O : Bar 141,25 To 147,31 : Ink B : Bar 141,17 To 147,23 : Ink F : Bar 141,9 To 147,15
  228.    Locate 20,2 : Ink F,B,O : Pen 25
  229.    If W
  230.       Set Pattern P : Bar 244,16 To 258,23 : Print "Pattern ON";
  231.    Else 
  232.       Ink 31 : Set Pattern 0 : Bar 244,16 To 258,23 : Print "Pattern OFF";
  233.    End If 
  234.    Locate 20,3 : Pen 23
  235.    If S
  236.       Print "Outline ON ";
  237.    Else 
  238.       Print "Outline OFF";
  239.    End If 
  240.    Locate 20,1 : Pen 27
  241.    If T
  242.       Print "Select= Foreground"
  243.    Else 
  244.       Print "Select= Background"
  245.    End If 
  246.    Ink 2 : Box 270,17 To 320,39
  247.    Draw 155,0 To 155,40
  248.    Ink 2,31 : Text 280,25,"Mode"
  249.    Paste Bob 274,28,M+1
  250.    Screen 0
  251. End Proc